home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / progjour / 1987 / 06 / shell.pas < prev    next >
Pascal/Delphi Source File  |  1987-08-23  |  13KB  |  411 lines
  1. {$Z63,S3,V+,E1,W-,F1,T0}
  2.  
  3. (*  copyright 1987, John J. Newlin
  4.     Z63 = full optimization
  5.      S3 = allow Pascal extensions
  6.      V+ = allow variable length strings
  7.      E1 = use actual procedure names for linking
  8.      W- = suppress warnings about unused variables
  9.      F1 = optimize for speed
  10.      T0 = do not generate symbol table info
  11. *)
  12.  
  13. program shell(input,output);
  14. import sheltool;
  15.  
  16. const
  17.   win1_beg = 5;
  18.   win2_beg = win1_beg + 10;
  19.   win_col = 2;
  20.   win3_beg = 5;
  21.   win3_col = 61;
  22.  
  23. var
  24.   paragraphs,action,code,i : integer;
  25.   total,count,x,y,curr_page,last_page,index : array[1..windows] of integer;
  26.   root_dir,current_dir,default_dir,str : string;
  27.   dir : array[1..windows] of str64;
  28.   beg_y,max_y : array[1..windows] of integer;
  29.   copy_flag,window_flag : boolean;
  30.   key,last_drive : char;
  31.   drive_list : array[1..26] of char;
  32.  
  33. procedure terminate;
  34. begin
  35.   code := chdir(default_dir);
  36.   rest_cursor;
  37.   cls(15);
  38.   halt;
  39. end;
  40.  
  41. procedure rename_file(oldfile,newfile : string);
  42. var f : text;
  43. begin
  44.   reset(f,oldfile);
  45.   close(f);
  46.   rename(f,newfile);
  47. end;
  48.  
  49. function user_entry(prompt : string) : string;
  50. var temp,blank : string;
  51.     i : integer;
  52. begin
  53.   screenwrite(4,2,main_color,prompt);
  54.   setxy(4,3);
  55.   rest_cursor;
  56.   readln(temp);
  57.   hide_cursor;
  58.   fillstr(blank,70,chr(32));
  59.   screenwrite(4,2,main_color,blank);
  60.   screenwrite(4,3,main_color,blank);
  61.   for i := 1 to length(temp) do temp[i] := upcase(temp[i]);
  62.   user_entry := temp;
  63. end;
  64.  
  65. procedure get_drive_list;
  66. var regs : regtype;
  67.     i : integer;
  68. begin
  69.   regs.ax := 16#0E00#;
  70.   regs.dx := ord(current_dir[1]) - 65;
  71.   msdos(regs);
  72.   last_drive := chr(lo(regs.ax) + 64);
  73.   for i := 65 to ord(last_drive) do drive_list[i-64] := chr(i);
  74.   drive_list[ord(last_drive)-63] := chr(0);
  75. end;
  76.  
  77. procedure copy_file(index,win : integer; var files : file_array);
  78. var cmd : string;
  79.     dest : integer;
  80. begin
  81.   if win = 1 then dest := 2 else dest := 1;
  82.   cmd := concat('COPY ',files[index].name," ",dir[dest],' > NUL');
  83.   cmd := concat(" ",cmd," ");
  84.   cmd[length(cmd)] := chr(13);
  85.   cmd[1] := chr(length(cmd));
  86.   exec(cmd);
  87.   copy_flag := true;
  88. end;
  89.  
  90. procedure scroll_it(y,lines,dir : integer);
  91. begin
  92.   scroll(3,y,46,y+7,lines,main_color,dir);
  93. end;
  94.  
  95. procedure drive_menu;
  96. var i,code,index,last,keystat,ascii,scan : integer;
  97.         str : string;
  98.  
  99. function drive_str(indx : integer) : string;
  100. begin
  101.   drive_str := 'Drive  ';
  102.   drive_str[7] := drive_list[indx];
  103. end;
  104.  
  105. begin
  106.   last := ord(last_drive) - 64;
  107.   draw_box(win3_col,win3_beg,10,last+1);
  108.   scroll(win3_col+1,win3_beg+1,win3_col+8,win3_beg+last,last,main_color,0);
  109.   for i := 1 to last do
  110.     begin
  111.       str := drive_str(i);
  112.       screenwrite(win3_col+1,i+win3_beg,main_color,str);
  113.     end;
  114.   index := ord(current_dir[1]) - 64;
  115.   loop
  116.     str := drive_str(index);
  117.     fx(8,curs_color,win3_col+1,index+win3_beg,main_color,str);
  118.     repeat until keycode(keystat,ascii,scan);
  119.     if scan = 1 then terminate;
  120.     if scan = 28 then
  121.       begin
  122.         str[1] := drive_list[index];
  123.         str[2] := ':';
  124.         str[3] := chr(0);
  125.         code := chdir(str);
  126.         return;
  127.       end;
  128.     if (scan = down) then
  129.       begin
  130.         fx(0,curs_color,win3_col+1,index+win3_beg,main_color,str);
  131.         if index < last then index := succ(index)
  132.           else if index = last then index := 1;
  133.       end;
  134.     if (scan = up) then
  135.       begin
  136.         fx(0,curs_color,win3_col+1,index+win3_beg,main_color,str);
  137.         if index > 1 then index := pred(index)
  138.           else if index = 1 then index := last;
  139.       end;
  140.     if scan = tab then return;
  141.   end;
  142. end;
  143.  
  144. procedure top_line(y : integer; var dir : str64);
  145. var line : string;
  146.     i : integer;
  147. begin
  148.   fillstr(line,44,chr(196));
  149.   for i := 1 to length(dir) do line[i+2] := dir[i];
  150.   screenwrite(win_col+1,y,main_color,line);
  151. end;
  152.  
  153. function show(index:integer; var files : file_array) : string;
  154. var ftime,fdate : string[14];
  155.     st : string;
  156.     fname : str12;
  157.     num : string;
  158.     long : longint;
  159. begin
  160.    with files[index] do
  161.      begin
  162.        if desig = 255 then fname := '[ DELETED  ]' else
  163.           fname := convert(name);
  164.        long[0] := losize;
  165.        long[1] := hisize;
  166.        case attr of
  167.          chr(8),chr(40)  : num := '  <VOL>';
  168.          chr(16),chr(48) : num := '  <DIR>';
  169.          otherwise num := format_num(long,7);
  170.        end;
  171.        ftime := filetime(time);
  172.        fdate := filedate(date);
  173.        st := concat(fname,'  ',fdate,'  ',ftime,'  ',num);
  174.      end;
  175.   show := st;
  176. end;
  177.  
  178. function executable(var filename : str12) : boolean;
  179. begin
  180.   executable := ( (pos('.EXE',filename) > 0) or (pos('.COM',filename) > 0) or
  181.                   (pos('.BAT',filename) > 0) );
  182. end;
  183.  
  184. procedure view_dir(var files : file_array; win : integer; flag : boolean);
  185. var keystat,ascii,code,scan,ytop,ymax : integer;
  186.     name,s4,mask : string[14];
  187.     key : char;
  188.     ft : boolean;
  189.     command,filedat,oldname,newname : string;
  190.     label 88,99;
  191.  
  192. begin
  193.   ytop := beg_y[win];
  194.   ymax := max_y[win];
  195.   if copy_flag then
  196.     begin
  197.       copy_flag := false;
  198.       flag := true;
  199.     end;
  200.   88: scan := 0;
  201.   code := chdir(dir[win]);
  202.   top_line(ytop,dir[win]);
  203.   if not flag then goto 99;
  204.   scroll_it(ytop+1,8,0);
  205.   mask := '*.*';
  206.   get_files(mask,files,total[win]);
  207.   if total[win] = 0 then goto 99;
  208.   sort_files(files,total[win]);
  209.   index[win] := 0;
  210.   count[win] := 0;
  211.   x[win] := 3;
  212.   y[win] := ytop;
  213.   last_page[win] := (total[win] div 8) + 1;
  214.   if total[win] mod 8 = 0 then last_page[win] := pred(last_page[win]);
  215.   curr_page[win] := 1;
  216.   if (index[win] < total[win]) then
  217.     loop
  218.       count[win] := succ(count[win]);
  219.       index[win] := succ(index[win]);
  220.       y[win] := succ(y[win]);
  221.       filedat := show(index[win],files);
  222.       screenwrite(x[win],y[win],main_color,filedat);
  223.       if  (count[win] > 7) or (index[win] >= total[win]) or (total[win] = 0) then
  224.         begin
  225.           y[win] := ytop + 1;
  226.           index[win] := (curr_page[win] * 8) - 7;
  227.       99: repeat
  228.             curr_page[win] := (index[win] div 8);
  229.             if index[win] mod 8 <> 0 then
  230.                curr_page[win] := succ(curr_page[win]);
  231.             filedat := show(index[win],files);
  232.             if total[win] = 0 then 
  233.               begin
  234.                 filedat := 'No files present';
  235.                 y[win] := ytop + 1;
  236.               end;
  237.             fx(length(filedat)+1,curs_color,x[win],
  238.                       y[win],main_color,filedat);
  239.             repeat until keycode(keystat,ascii,scan);
  240.             if scan = del then
  241.               begin
  242.                 purge(files[index[win]].name);
  243.                 files[index[win]].desig := 255;
  244.               end;
  245.             if scan = ins then
  246.               begin
  247.                 oldname := files[index[win]].name;
  248.                 newname := user_entry('Enter new file name');
  249.                 rename_file(oldname,newname);
  250.                 files[index[win]].name := newname;
  251.               end;
  252.             if (ascii = 0) and (scan = ctrl_home) then
  253.               begin
  254.                 dir[win] := root_dir;
  255.                 flag := true;
  256.                 goto 88;
  257.               end;
  258.             if (ascii = 0) and (scan = ctrl_end) then
  259.               begin
  260.                 dir[win] := default_dir;
  261.                 flag := true;
  262.                 goto 88;
  263.               end;
  264.             if (ascii = 0) and (scan = ctrl_pgup) then
  265.               begin
  266.                 s4 := '..';
  267.                 code := chdir(s4);
  268.                 getdir(dir[win]);
  269.                 flag := true;
  270.                 goto 88;
  271.               end;
  272.             if total[win] = 0 then return;
  273.             if scan = 46 then copy_file(index[win],win,files);  {'c'}
  274.             if scan = 32 then                                   {'d}
  275.               begin
  276.                 drive_menu;
  277.                 getdir(dir[win]);
  278.                 flag := true;
  279.                 goto 88;
  280.               end;
  281.             if (scan = retkey) and (files[index[win]].attr = chr(16)) then
  282.               begin
  283.                 flag := true;
  284.                 if dir[win][length(dir[win])] <> '\' then
  285.                 dir[win] := concat(dir[win],"\",files[index[win]].name) else
  286.                   dir[win] := concat(dir[win],files[index[win]].name);
  287.                 goto 88;
  288.               end;
  289.             if (scan = retkey) and executable(files[index[win]].name) then
  290.               begin
  291.                 command := files[index[win]].name;
  292.                 execute(command);
  293.                 scan := 0;
  294.               end;
  295.             if scan = esc then terminate;
  296.             if scan = tab then
  297.               begin
  298.                 screenwrite(x[win],y[win],main_color,filedat);
  299.                 return;
  300.               end;
  301.             if (scan in [home,down,up,pgdn,pgup,endkey]) then
  302.               begin
  303.                  screenwrite(x[win],y[win],main_color,filedat);
  304.                  case scan of
  305.                   home : if curr_page[win] > 1 then 
  306.                            begin
  307.                              index[win] := 0;
  308.                              curr_page[win] := 1;
  309.                            end else scan := 0;
  310.                 endkey : if curr_page[win] < last_page[win] then
  311.                            begin
  312.                              curr_page[win] := last_page[win];
  313.                              index[win] := (last_page[win]  * 8) - 8;
  314.                              scroll_it(ytop+1,8,0);
  315.                            end else scan := 0;
  316.                   down : begin
  317.                            if index[win] = total[win] then
  318.                              begin
  319.                                index[win] := 
  320.                                  index[win] - (y[win] - ytop) + 1;
  321.                                y[win] := ytop + 1;
  322.                              end else
  323.                            if index[win] + 1 <= total[win] then
  324.                              begin
  325.                                index[win] := succ(index[win]);
  326.                                if y[win] + 1 <= ymax then
  327.                                  y[win] := succ(y[win]) else 
  328.                                    scroll_it(ytop+1,1,0);
  329.                              end;
  330.                          end;
  331.                     up : begin
  332.                            if index[win] = 1 then
  333.                              begin
  334.                                if total[win] > 8 then
  335.                                  begin
  336.                                    y[win] := ymax;
  337.                                    index[win] := index[win] + 7;
  338.                                  end
  339.                                else
  340.                                  begin
  341.                                    y[win] := ytop + total[win];
  342.                                    index[win] := total[win];
  343.                                  end
  344.                              end 
  345.                            else if index[win] - 1 >= 0 then
  346.                              begin
  347.                                index[win] := pred(index[win]);
  348.                                if y[win] - 1 >= ytop + 1
  349.                                  then y[win] := pred(y[win])
  350.                                   else scroll_it(ytop+1,1,1);
  351.                               end;
  352.                           end;
  353.                    pgup : if curr_page[win] > 1 then
  354.                             begin
  355.                               curr_page[win] := pred(curr_page[win]);
  356.                               index[win] := curr_page[win] * 8 - 8;
  357.                             end 
  358.                           else index[win] := 0;
  359.                    pgdn : if curr_page[win] <= last_page[win] then
  360.                             begin
  361.                               if curr_page[win] < last_page[win] then
  362.                                 begin
  363.                                   index[win] := curr_page[win] * 8;
  364.                                   curr_page[win] := succ(curr_page[win]);
  365.                                   scroll_it(ytop+1,8,0);
  366.                                 end else scan := 0;
  367.                             end;
  368.                 end; {of case}
  369.               end;  {of if scan in []}
  370.           until scan in [home,endkey,pgup,pgdn];
  371.           y[win] := ytop;
  372.           count[win] := 0;
  373.         end;  {of if count[win]}
  374.     end;  {of loop}
  375. end;
  376.  
  377.  
  378. procedure initialize;
  379. begin
  380.   window_flag := true;
  381.   getdir(current_dir);
  382.   root_dir := copy(current_dir,1,3);
  383.   draw_box(win_col,win1_beg,46,9);
  384.   draw_box(win_col,win2_beg,46,9);
  385.   draw_box(1,1,78,3);
  386.   dir[1] := current_dir;
  387.   dir[2] := root_dir;
  388.   beg_y[1] := win1_beg;
  389.   beg_y[2] := win2_beg;
  390.   max_y[1] := win1_beg + 8;
  391.   max_y[2] := win2_beg + 8;
  392. end;
  393.  
  394. begin
  395.   paragraphs := set_mem;
  396.   get_drive_list;
  397.   cls(15);
  398.   save_cursor;
  399.   hide_cursor;
  400.   getdir(default_dir);
  401.   initialize;
  402.   str := ' The Shell Game - by John Newlin ';
  403.   screenwrite(6,1,main_color,str);
  404.   loop
  405.     view_dir(files[1],1,window_flag);
  406.     view_dir(files[2],2,window_flag);
  407.     if window_flag then window_flag := false;
  408.   end;
  409. end.
  410.  
  411.